Making Christmas Cards in R

Oxford R User Group
27 November 2023

Nicola Rennie

About Me

Lecturer in Health Data Science at Lancaster University.

Academic background in statistics, and experience in data science consultancy.

Blog about R and data science at nrennie.rbind.io/blog.

Christmas in R

{christmas}

library(christmas)
xmasepitree(year = 2023)

`snow` Quarto extension

quarto install extension emilhvitfeldt/quarto-snow

GitHub: github.com/EmilHvitfeldt/quarto-snow

Gif of falling snow against a set of slides

Let’s build a snowman!

R packages we need

{ggplot2}: for drawing plots
{ggforce}: for drawing circles
{sf}: for working with spatial data

pkgs <- c("ggplot2", "ggforce", "sf")
install.packages(pkgs)

What makes a snowman?

Head and body
Buttons and eyes
Hat
Arms
Nose
Sky
Snowflakes
Snow

What makes a snowman?

Head and body (circles with geom_circle())
Buttons and eyes (points with geom_point())
Hat (rectangles with geom_rect())
Arms (lines with geom_segment())
Nose (polygon with geom_sf())
Sky (styling with theme())
Snowflakes (points with geom_point())
Snow (rectangle with geom_rect())

Starting with the sky…

library(ggplot2)
s1 <- ggplot() +
  theme_void() +
  theme(
    plot.background = element_rect(
      fill = "#0e1c2e"
      )
  )
s1

Add some snow…

s2 <- s1 +
  annotate(
    geom = "rect",
    xmin = 0, xmax = 1,
    ymin = 0, ymax = 0.2,
    fill = "gray98",
    colour = "gray98"
  ) +
  xlim(0, 1) +
  ylim(0, 1) +
  coord_fixed(expand = FALSE)
s2

…and some snowflakes!

set.seed(20231225)
n <- 100
snowflakes <- data.frame(
  x = runif(n),
  y = runif(n)
)
s3 <- s2 +
  geom_point(
    data = snowflakes,
    mapping = aes(
      x = x,
      y = y
    ),
    colour = "white",
    pch = 8
  )
s3

Build the snowman!

library(ggforce)
s4 <- s3 +
  geom_circle(
    data = data.frame(
      x0 = c(0.6, 0.6),
      y0 = c(0.3, 0.5),
      r = c(0.15, 0.1)
    ),
    mapping = aes(x0 = x0, y0 = y0, r = r),
    fill = "white",
    colour = "white"
  )
s4

Add some rocks for buttons and eyes…

s5 <- s4 +
  geom_point(
    data = data.frame(
      x = c(0.6, 0.6, 0.6, 0.57, 0.62),
      y = c(0.25, 0.3, 0.35, 0.52, 0.52),
      size = runif(5, 2, 4.5)
    ),
    mapping = aes(x = x, y = y, size = size)
  ) +
  scale_size_identity()
s5

… and sticks for arms …

s6 <- s5 + 
  annotate(
    geom = "segment",
    x = 0.7, xend = 0.85, y = 0.3, yend = 0.4,
    colour = "chocolate4",
    linewidth = 2
  ) +
  annotate(
    geom = "segment",
    x = 0.46, xend = 0.33, y = 0.3, yend = 0.4,
    colour = "chocolate4",
    linewidth = 2
  )
s6

and a hat!

s7 <- s6 +
  annotate(
    geom = "rect",
    xmin = 0.46, xmax = 0.74,
    ymin = 0.56, ymax = 0.6,
    fill = "brown"
  ) +
  annotate(
    geom = "rect",
    xmin = 0.5, xmax = 0.7,
    ymin = 0.56, ymax = 0.73,
    fill = "brown"
  )
s7

Create a carror for a nose with {sf}…

library(sf)
nose_pts <- matrix(
  c(
    0.6, 0.5,
    0.65, 0.48,
    0.6, 0.46,
    0.6, 0.5
  ),
  ncol = 2,
  byrow = TRUE
)
nose <- st_polygon(list(nose_pts))
plot(nose)

… and add it to the snowman

s8 <- s7 +
  geom_sf(
    data = nose,
    fill = "orange",
    colour = "orange"
  ) +
  coord_sf(expand = FALSE)
s8

Finally add a Christmas message!

s9 <- s8 +
  annotate(
    geom = "text",
    x = 0.5, y = 0.95,
    label = "Merry Christmas",
    colour = "red3",
    fontface = "bold", size = 9
  ) +
  annotate(
    geom = "text",
    x = 0.5, y = 0.07,
    label = "To ...\n From ...",
    colour = "red3",
    fontface = "bold", size = 5
  )
s9

Sending Christmas cards in R

Email your Christmas card

{blastula}: a package for creating and sending HTML emails from R.
{gmailR}: a package for sending emails via the Gmail’s RESTful API.
{RDCOMClient}: a Windows-specific package for sending emails in R from the Outlook app.

… and several other email R packages!

{ggirl}

library(ggirl)
contact_email <- "fakeemailforreal@gmail.com"
send_address_1 <- address(
  name = "Fake Personname",
  address_line_1 = "250 North Ave",
  city = "Boston", state = "MA",
  postal_code = "22222", country = "US"
)
message_1 <- "This plot made me think of you!"
ggpostcard(
  plot,
  contact_email,
  messages = message_1,
  send_addresses = send_address_1
)